-- Pr5
import System.Random

learn_coef = 0.3

type Weight = Float
type Neuron = [Weight]
type NeuralNetwork = (Neuron, Neuron, Neuron)


-- initializes neural network's synopsis with random weights
initNeuralNetwork :: IO NeuralNetwork
initNeuralNetwork = do
    gen <- getStdGen
    let weights = take 6 $ randoms gen :: [ Float ]
    return ([weights !! 0, weights !! 1], [weights !! 2, weights !! 3], [weights !! 4, weights !! 5])

-- calculates the output of neuron using input signals
calcOutput :: Neuron -> [Float] -> Float
calcOutput synopsis inputs = 1 / (1 + exp (-(sum (zipWith (*) synopsis inputs))))

-- uses neural network to calculate its output
solve :: NeuralNetwork -> [Float] -> Float
solve (w0, w1, w2) inputs = calcOutput w2 [calcOutput w0 inputs, calcOutput w1 inputs]

backPropagation :: Neuron -> [Float] -> Float -> Neuron
backPropagation neuron outputs sigma =
    zipWith (\weight output -> weight + learn_coef * sigma * output) neuron outputs

-- learns NeuralNetwork using inputs and needed output
learn :: NeuralNetwork -> [Float] -> Float -> NeuralNetwork
learn (w0, w1, w2) inputs result = let
    z0 = calcOutput w0 inputs
    z1 = calcOutput w1 inputs
    zs = [z0 ,z1]
    y = calcOutput w2 zs
    sigma = y * (1 - y) * (result - y)
    w2_new = backPropagation w2 zs sigma
    sigma0 = z0 * (1 - z0) * sigma * (w2_new !! 0)
    sigma1 = z1 * (1 - z1) * sigma * (w2_new !! 1)
    w0_new = backPropagation w0 inputs sigma0
    w1_new = backPropagation w1 inputs sigma1
    in (w0_new, w1_new, w2_new)

-- makes n learnings of neural network
learnBatch :: NeuralNetwork -> Int -> IO NeuralNetwork
learnBatch network n = do
    gen <- getStdGen
    let randoms_list = randoms gen :: [ Float ]
    return $ fst $ foldl (\(netw, (a:b:xs)) _ -> let
        inputs@[x0, x1] = map (\r -> if r > 0.5 then 1 else 0) [a, b]
        in (learn netw inputs (fromIntegral ((round (x0 + x1)) `mod` 2)), xs)) (network, randoms_list) [1..n]

main = do
    network <- initNeuralNetwork
    learnedNetwork <- learnBatch network 50000
    print $ solve learnedNetwork [0, 0]
    print $ solve learnedNetwork [0, 1]
    print $ solve learnedNetwork [1, 0]
    print $ solve learnedNetwork [1, 1]

